home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 1999 January / PC Plus Super CD No55a (PCP-147A-1-99) (Disc 1) (1998).iso / linux / developers / visualtcl / windows / vtcl / lib / toolbar.tcl < prev    next >
Encoding:
Text File  |  1997-09-14  |  2.4 KB  |  84 lines
  1. ##############################################################################
  2. # $Id: toolbar.tcl,v 1.5 1997/09/14 21:08:30 stewart Exp $
  3. #
  4. # toolbar.tcl - widget toolbar
  5. #
  6. # Copyright (C) 1996-1997 Stewart Allen
  7. #
  8. # This program is free software; you can redistribute it and/or
  9. # modify it under the terms of the GNU General Public License
  10. # as published by the Free Software Foundation; either version 2
  11. # of the License, or (at your option) any later version.
  12. #
  13. # This program is distributed in the hope that it will be useful,
  14. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. # GNU General Public License for more details.
  17. #
  18. # You should have received a copy of the GNU General Public License
  19. # along with this program; if not, write to the Free Software
  20. # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22. ##############################################################################
  23. #
  24.  
  25. proc vTcl:toolbar_create {args} {
  26.     global vTcl
  27.     set base .vTcl.toolbar
  28.     if [winfo exists $base] {return}
  29.     toplevel $base -width 0 -height 0 -class vTcl
  30.     wm transient $base .vTcl
  31.     wm withdraw $base
  32.     wm title $base "Widget Toolbar"
  33.     wm grid $base 1 1 20 20
  34.     wm geometry $base +0+110
  35.     catch {wm geometry .vTcl.toolbar $vTcl(geometry,.vTcl.toolbar)}
  36.     wm protocol .vTcl.toolbar WM_DELETE_WINDOW {
  37.         vTcl:error "You cannot remove the toolbar"
  38.     }
  39. }
  40.  
  41. proc vTcl:toolbar_add {type name image cmd_add} {
  42.     global vTcl
  43.     if ![winfo exists .vTcl.toolbar] {
  44.         vTcl:toolbar_create
  45.     }
  46.     set base .vTcl.toolbar
  47.     set f [vTcl:new_widget_name tb $base]
  48.     button $f -bd 1 -image $image -comm "vTcl:new_widget $type \"$cmd_add\""
  49.     vTcl:set_balloon $f $name
  50.     lappend vTcl(tool,list) $f
  51. }
  52.  
  53. proc vTclWindow.vTcl.toolbar {args} {
  54.     vTcl:toolbar_reflow
  55. }
  56.  
  57. proc vTcl:toolbar_reflow {} {
  58.     global vTcl
  59.     set base .vTcl.toolbar
  60.     wm resizable $base 1 1
  61.     set num [llength [winfo children $base]]
  62.     set w $vTcl(toolbar,width)
  63.     set h [expr $num / $w]
  64.     set x 0
  65.     set gr ""
  66.     foreach i $vTcl(tool,list) {
  67.         append gr "$i "
  68.         incr x
  69.         if {$x >= $w} {
  70.             eval "grid $gr"
  71.             set x 0
  72.             set gr ""
  73.         }
  74.     }
  75.     if {$gr != ""} {
  76.         eval "grid $gr"
  77.     }
  78.     update idletasks
  79.     vTcl:setup_vTcl:bind .vTcl.toolbar
  80.     wm geometry $base 1x1
  81.     wm deiconify $base
  82. }
  83.  
  84.